Matrices

Central Magnet School

Lesson Overview

The student will learn about

Multiplying Matrices

Geometric Transformations

Augmented Matrices

Modulo

parameters={a,c,d,x}

Adding Matrices

Make sure you understand the basics of addition. It is simple, but don’t get it confused with the multiplication process you will see later.

Manipulate[
Text@Column[{
Style[Row[{x,If[y<0," - "," + "],Abs[y]," = ",x+y}],36,Bold,red],
Style[Row[{MatrixForm[{{1,Style[x,red]},{0,1}}],"+",MatrixForm[{{1,Style[y,red]},{0,1}}]," = ",MatrixForm[{{1,Style[x+y,red]},{0,1}}]}],24,Bold]
},
Center,Spacings->4],
{{x,3,"(Subscript[A, 1, 2])"},-10,10,1,Appearance->"Labeled"},
{{y,2,"(Subscript[B, 1, 2])"},-10,10,1,Appearance->"Labeled"},ControlPlacement->Top,
Initialization:>(
red=RGBColor[.7,0,0]),
ContentSize->{475,260},Alignment->Center]

Journal: Can you add matrices of different sizes? Why or why not?

Matrix Multiplication

Multiplying Matrices does not follow normal multiplication rules. Here is a nice visual of where the numbers come from. In general, we multiply the terms in order (row by column) then add the results. Try following this simple example, then add more rows and columns to add difficulty. Notice that the amount of columns in the first matrix must match the number of rows in the second matrix. Also, the resultant will have the same number of rows as matrix A and the same number of columns as matrix B.

                                                            Rule:    (MxN times NxP = MxP)

Manipulate[
If[col>Bcols,col=1;col=col];
If[row>Arows,row=1;row=row];

Brows=Acols;
matA=Take[A1,{1,Arows},{1,Acols}];
matB=Take[B1,{1,Brows},{1,Bcols}];

rowclr=Lighter[Green,0.7]; colclr=Lighter[Blue,0.7];

Pane[
Text@Column[{

Item[Row[{Column[{Text@Style["A",Italic,18],MatrixForm[{Style[Grid[matA,Alignment->{Right,Bottom},Spacings->{1,0.5},Background->{None,row->rowclr}],16]}]},Alignment->Center],
Column[{Text@Style["B",Italic,18],
MatrixForm[{Style[Grid[matB,Alignment->{Right,Bottom},Spacings->{1,0.5},Background->{col->colclr,None}],16]}]},Alignment->Center]}],ItemSize->{Automatic,7},Alignment->Center],

Item[Row[{Text@Style["Answer   AB = ",Italic,18],MatrixForm[{Style[Grid[matA.matB,Alignment->{Right,Bottom},Spacings->{1,0.5},Background->{None,None,{{row,col}->Blend[{rowclr,colclr}]}},Frame->{col->colclr,row->rowclr}],16]}]}],ItemSize->{Automatic,10},Alignment->Center],

Style[Column[{
Grid[{Prepend[Append[Riffle[Riffle[matA[[row]],Transpose[matB][[col]]],If[Acols==1,")(",{")(",") + ("}]],")"],"("]},Spacings->0,ItemSize->{Riffle[Table[Automatic,{Acols*2+1}],1.5],1.2},Alignment->Center,Background->{Prepend[Append[Riffle[Flatten[Table[{rowclr,colclr},{Acols}]],None],None],None]}]," = ",
Grid[{Riffle[Map[Apply[Times,#]&,Partition[Riffle[matA[[row]],Transpose[matB][[col]]],2]],"   +   "]}]," = ",
Grid[{{matA[[row]].Transpose[matB][[col]]}},ItemSize->{2.5,1.2},Background->Blend[{rowclr,colclr}]]
},Alignment->Center],16]

},Alignment->Center,Spacings->1,Frame->{{},True},FrameStyle->Lighter[Gray,0.5]
],
ImageSize->{400,400},
Alignment->{Center,Center}],
{{Arows,2,"A's rows"},Range[1,5],ControlType->PopupMenu},
"",
{{Acols,2,Column[{"A's columns","     B's rows"}]},Range[1,5],ControlType->PopupMenu},
"",
{{Bcols,2,"B's columns"},Range[1,5],ControlType->PopupMenu},
Button["new matrices",A1=Table[RandomInteger[{-5,5}],{5},{5}];
B1=Table[RandomInteger[{-5,5}],{5},{5}];],
{{row,1,"row"},1,Arows,1,ImageSize->Tiny},
{{col,1,"column"},1,Bcols,1,ImageSize->Tiny},
{{A1,Table[RandomInteger[{-5,5}],{5},{5}]},ControlType->None},
{{B1,Table[RandomInteger[{-5,5}],{5},{5}]},ControlType->None},
ControlPlacement->Left,
TrackedSymbols:>Manipulate,
AutorunSequencing->{1,2,3,4,5}]

Geometric Transformations

Matrix multiplication can be used to change the graph of various figures. The matrix A = ({{x}, {y}})[({{0}, {0}})({{0, 2, 3, 3, 3, 3, 4, 4}, {2, 2, 0, 1, 2, 3, 1, 2}})] represents the original dog. The matrix B made from the sliders is the translation matrix. When we multiply BxA we get the resultant matrix/figure. Notice that [({{1, 0}, {0, 1}})] does not change the graph.

Manipulate[
Graphics[{{Thick,Line[Choose]},
{Thick,RGBColor[0,.5,.6],Line[Choose.{{x1,y1},{x2,y2}}]}},Axes->True,PlotRange->{{-10,10},{-10,10}},m=Invisible[MatrixForm[{{(1/2),0},{(1/2),0}}]];
PlotLabel->Style[Row[{m MatrixForm[{{Style["a",Italic],Style["b",Italic]},{Style["c",Italic],Style["d",Italic]}}]}]==Row[{MatrixForm[{{x1,y1},{x2,y2}}],m}],20],ImageSize->{500,350}],
Row[{"How does changing ",Text@Style["a",Italic],", ",Text@ Style["b",Italic], ", ",Text@Style["c",Italic],", or ", Text@Style["d",Italic], " change the figure?"}],
{{x1,1,Text@Row[{Style["a",Italic],Invisible[(1/2)]}]},-3,3,1/4,Appearance->"Labeled"},
{{y1,0,Text@Row[{Style["b",Italic],Invisible[(1/2)]}]},-3,3,1/4,Appearance->"Labeled"},
{{x2,0,Text@Row[{Style["c",Italic],Invisible[(1/2)]}]},-3,3,1/4,Appearance->"Labeled"},
{{y2,1,Text@Row[{Style["d",Italic],Invisible[(1/2)]}]},-3,3,1/4,Appearance->"Labeled"},
{{Choose,{{0,0},{3,0},{3,1},{4,1},{4,2},{3,2},{3,3},{2,2},{0,2},{0,0}},"choose"},{{{0,0},{3,0},{3,1},{4,1},{4,2},{3,2},{3,3},{2,2},{0,2},{0,0}}->"dog",{{0,0},{3,0},{3,2},{4,3},{4,4},{3,5},{3,4},{2,4},{2,5},{1,4},{1,3},{2,2},{0,2},{0,0}}->"cat",{{0,0},{2,0},{2,2},{3,2},{3,3},{3.5,3},{3.5,3.5},{3,3.5},{3,3},{2,3},{2,3.5},{1.5,3.5},{1.5,3},{2,3},{2,2},{0,2},{0,0}}->"mouse"}}]

Journal: Would multiplying AxB give us the same result? Multiply [({{-2, 0}, {0, -2}})] times the original by hand and graph the original and result.

Translations

Horizontal and Vertical translations are shown below.

Manipulate[
Graphics[
{{Thick,Line[{{0,0},{3,0},{3,1},{4,1},{4,2},{3,2},{3,3},{2,2},{0,2},{0,0}}]},
{Thick,RGBColor[0,.5,.6],Line[({{0,0},{3,0},{3,1},{4,1},{4,2},{3,2},{3,3},{2,2},{0,2},{0,0}}+Table[{x,y},{10}])]}},
ImageSize->{400,400},
Axes->True,
PlotRange->{{-10,10},{-10,10}}],

Style[Row[{"How does changing ",Text@Style["x",Italic]," and ",Text@Style["y",Italic] ,  " change the dog?"}],Medium],

{{x,0},-10,6,1/4,Appearance->"Labeled"},
{{y,0},-10,7,1/4,Appearance->"Labeled"}]

Journal: Come up with the matrix that would shift the figure left 5 and up 7. Is the operation still multiplication? What is the resulting matrix?

Rotations

In general, to rotate counterclockwise multiply by [({{cosθ, -sinθ}, {sinθ, cosθ}})] and clockwise by [({{cosθ, sinθ}, {-sinθ, cosθ}})], where θ is the angle by which you wish to rotate.
For example, to rotate (90^o) counterclockwise multiply by [({{0, -1}, {1, 0}})]. To rotate (180^o) counterclockwise multiply by [({{-1, 0}, {0, -1}})].  
To rotate (270^o) counterclockwise multiply by [({{0, 1}, {-1, 0}})]. Lastly, to rotate (360^o) in either direction multiply by the identity matrix  [({{1, 0}, {0, 1}})].
Slide the angle of rotation θ  and watch how the figure is altered.

Manipulate[
Graphics[
{{Thick,Line[{{0,0},{3,0},{3,1},{4,1},{4,2},{3,2},{3,3},{2,2},{0,2},{0,0}}]},
{Thick,RGBColor[0,.5,.6],Line[RotationMatrix[θ].#&/@{{0,0},{3,0},{3,1},{4,1},{4,2},{3,2},{3,3},{2,2},{0,2},{0,0}}]}},ImageSize->{400,400},Axes->True,PlotRange->{{-10,10},{-10,10}}],Style["How does changing θ change the dog?",Medium],
{{θ,0},-2π,2π,π/6,Appearance->"Labeled"}]

Journal: Using the translation matrices given above, what would be the transition matrix for rotating (90^o) clockwise? (180^o) clockwise? (270^o) clockwise? (360^o) clockwise?

3x3 Determinants

The determinant of a matrix has many applications in algebra, calculus, and advanced linear algebra. If the matrix represents coefficients of a linear system then a nonzero (anything but zero) determinant indicates that there is a unique solution to that system (and no inverse). This happens when: 1. An entire row of zeros 2. Two rows or columns are equal 3. A row or column is a constant multiple of another row or column.
You have already learned how to find the determinant of a 2x2 matrix [({{a, b}, {c, d}})] = ad - bc. Here is a nice illustration of a 3x3 determinant.

Manipulate[
text2=Join[text1,Most@text1];
{{a,b,c},{d,e,f},{g,h,i}}=Reverse/@text1;
Pane[
Column[{
Graphics[{
Style[MapIndexed[Text,text2,{2}],18],
Line[{{.5,.8},{.5,3.2}}],Line[{{3.5,.8},{3.5,3.2}}],
{Blue,
Style[Text[a e i,{4,0}],18],
Style[Text[d h c,{5,0}],18],
Style[Text[g b f,{6,0}],18],
Opacity[.5],
Arrow[{{.5,3.5},{3.5,0.5}}],
Arrow[{{1.5,3.5},{4.5,0.5}}],
Arrow[{{2.5,3.5},{5.5,0.5}}]
},
{Red,
Style[Text[c e g,{4,4}],18],
Style[Text[f h a,{5,4}],18],
Style[Text[i b d,{6,4}],18],
Opacity[.5],
Arrow[{{.5,0.5},{3.5,3.5}}],
Arrow[{{1.5,0.5},{4.5,3.5}}],
Arrow[{{2.5,0.5},{5.5,3.5}}]
}
},
PlotRange->{{.5,6.5},{-.5,4.5}},
ImageSize->{400,250}
],
Text@Style[Row[{
"∴",
Graphics[{
Style[MapIndexed[Text,text1,{2}],18],
Line[{{.5,.8},{.5,3.2}}],Line[{{3.5,.8},{3.5,3.2}}]
},
PlotRange->{{.5,3.6},{.5,3.5}},
ImageSize->{120,90}
],

" = ",
Style[a e i,Blue]," + ",
Style[d h c,Blue]," + ",
Style[g b f,Blue]," - ",
"(",
Style[c e g,Red], " + ",
Style[f h a,Red]," + ",
Style[i b d,Red],")",
" = ",
a e i+d h c+g b f -(c e g+f h a+i b d)
}],18]
},Center],
ImageSize->{600,350}
],
{{text1,Reverse/@IdentityMatrix[3],""},Button["new numbers",text1=RandomInteger[{-10,10},{3,3}]]&},
TrackedSymbols->Manipulate
]

Journal: Do you think it would be possible to find the determinant of a matrix that is not square? For example, a 3x4 matrix? Why or why not?

Row Operations

Row operations allow us to simplify the left side of a matrix to the identity matrix and in doing so revealing the solution on the right. Here, the row operations are done with a click. Remember to go column by column, left to right. Select an example, then use the buttons in the elementary row operations to solve the system.

Manipulate[
Quiet[
Module[{systemSolution,noSolutionFlag,pointSolutionFlag,lineSolutionFlag,planeSolutionFlag,solX,solY,solZ,𝒫1SolutionExist,𝒫2SolutionExist,𝒫3SolutionExist,𝒫1Solution,𝒫2Solution,𝒫3Solution,xRange=30,yRange=30,zRange=30,arrowHead,arrow,plotPlane,plotLineSolution,showNothing,planeEqTo3D},

planeEqTo3D[planeEq_,color_]:=plotPlane[(Union[StringCases[ToString[{x,y,z}/.planeEq],ch:CharacterRange["x","z"]]]/.{"x"->x,"y"->y,"z"->z}),{x,y,z}/.planeEq[[1]],color];

arrowHead[headBegin_,headEnd_,sections_,beginRadius_,endRadius_,color_]:=Module[{interval,radiusInterval},interval=(headEnd-headBegin)/sections;
radiusInterval=(beginRadius-endRadius)/(sections-1);
Map[{color,Cylinder[#[[1]],#[[2]]]}&,Transpose[{Partition[NestList[#+interval&,headBegin,sections],2,1],NestList[(#-radiusInterval)&, beginRadius,(sections-1)]}]]
];

arrow[arrowBegin_,arrowEnd_,lineThickness_,setColor_]:={{Thickness[lineThickness],setColor,Line[{arrowBegin,(arrowEnd-(((arrowEnd-arrowBegin)/6)))}]},{EdgeForm[],
arrowHead[(arrowEnd-(((arrowEnd-arrowBegin)/6))),arrowEnd,10,(range/30),0.02,setColor]}};

plotPlane[{lx_,ly_},pEq_,color_]:=ParametricPlot3D[pEq,{lx,-range,range},{ly,-range,range},PlotStyle->color];

plotPlane[{lx_},pEq_,color_]:=ParametricPlot3D[pEq,{lx,-range,range},PlotStyle->color];

plotLineSolution[{lx_},sx_,sy_,sz_]:=ParametricPlot3D[{sx,sy,sz},{lx,-range,range},PlotStyle->{Thickness[(range/3750)],Red}];

plotLineSolution[{lx_,ly_},sx_,sy_,sz_]:=ParametricPlot3D[{sx,sy,sz},{lx,-range,range},{ly,-range,range},PlotStyle->{Thickness[(range/3750)],Red}];

(* adjustSliderMinMax enables adjustments of the slider-parameter's minimum and maximum when performing row operations, and thereby prevents the sliders from turning pink. *)
adjustSliderMinMax[param_,paramMin_,paramMax_]:=
With[{tempParamMin=Unevaluated[paramMin],tempParamMax=Unevaluated[paramMax]},
{
If[param<paramMin,tempParamMin=param,If[param>paramMax,tempParamMax=param,If[param≥-20,{tempParamMin=-20;If[param≤20,tempParamMax=20,Null]},Null]
]
]
}];(* end With *)

showNothing=Plot3D[Null,{x,0,1},{y,0,1}];

(* the next two If statements enables the user to see the system in its reduced row echolon form when showRowReduced is True and 
after return to the system's parameters prior to being shown in a reduced row echelon form. The variables a1m... act as memory. *)
If[(!showRowReduced && !firstTimeNotRowReduced),
{firstTimeNotRowReduced=True;
a1=a1mr;b1=b1mr;c1=c1mr;d1=d1mr;
a2=a2mr;b2=b2mr;c2=c2mr;d2=d2mr;
a3=a3mr;b3=b3mr;c3=c3mr;d3=d3mr},
Null];

If[(showRowReduced&&firstTimeNotRowReduced),
{firstTimeNotRowReduced=False;
a1mr=a1;b1mr=b1;c1mr=c1;d1mr=d1;
a2mr=a2;b2mr=b2;c2mr=c2;d2mr=d2;
a3mr=a3;b3mr=b3;c3mr=c3;d3mr=d3;
{{a1,b1,c1,d1},{a2,b2,c2,d2},{a3,b3,c3,d3}}=RowReduce[{{a1,b1,c1,d1},{a2,b2,c2,d2},{a3,b3,c3,d3}}]},
Null];

(* the next two If statements enables the user to return to the parameters that he or she was working with
prior to looking at the examples. *)
If[(!example==1&&firstTimeNotOneFlag),
{firstTimeNotOneFlag=False;
a1m=a1;b1m=b1;c1m=c1;d1m=d1;
a2m=a2;b2m=b2;c2m=c2;d2m=d2;
a3m=a3;b3m=b3;c3m=c3;d3m=d3},
Null;];

If[(example==1&&!firstTimeNotOneFlag),
{firstTimeNotOneFlag=True;
a1=a1m;b1=b1m;c1=c1m;d1=d1m;
a2=a2m;b2=b2m;c2=c2m;d2=d2m;
a3=a3m;b3=b3m;c3=c3m;d3=d3m},
Null;];

Switch[example,
2,
(* insert the new parameters for a point solution made from perpendicular planes *)
{firstTimeNotOneFlag=False;
a1=0;b1=0 ;c1=-5 ;d1=0;
a2=0;b2=-7; c2=0;d2=0;
a3=9;b3=0;c3=0; d3=0},

3,
(* line solution *)
{firstTimeNotOneFlag=False;
a1=0;b1=0 ;c1=-3 ;d1=0;
a2=7;b2=0; c2=-4;d2=0;
a3=7;b3=0;c3=0; d3=0},

4,
(* plane solution *)
{firstTimeNotOneFlag=False;
a1=-4;b1=-2 ;c1=-3 ;d1=13;
a2=-4;b2=-2; c2=-3;d2=13;
a3=-4;b3=-2;c3=-3; d3=13},

5,
(* no solution  *)
{firstTimeNotOneFlag=False;
a1=0;b1=0 ;c1=-3 ;d1=13;
a2=7;b2=0; c2=-4;d2=0;
a3=7;b3=0;c3=0; d3=20}
];

xRange=range;yRange=range;zRange=range;

𝒫1=a1 x+b1 y+c1 z==d1;
𝒫2=a2 x+b2 y+c2 z==d2;
𝒫3=a3 x+b3 y+c3 z==d3;

(* The complete system of equations *)
eqs={𝒫1,𝒫2,𝒫3};

systemSolution=Solve[eqs,{x,y,z}][[1]];
(* If length of systemSolution == 3 then there is a single point solution *)
If[Length[systemSolution]==3&&StringFreeQ[ToString[systemSolution],"{}"],{{solX,solY,solZ}={x,y,z}/.systemSolution;pointSolutionFlag=True},pointSolutionFlag=False];
(* If length of systemSolution == 2 then a line is the solution to the system *)
If[Length[systemSolution]==2&&StringFreeQ[ToString[systemSolution],"{}"],{{solX,solY,solZ}={x,y,z}/.systemSolution;lineSolutionFlag=True},lineSolutionFlag=False];
(* If length of systemSolution == 1 then plane is the solution to the system *)
If[Length[systemSolution]==1&&StringFreeQ[ToString[systemSolution],"{}"],{{solX,solY,solZ}={x,y,z}/.systemSolution;planeSolutionFlag=True},planeSolutionFlag=False];
(* If length of systemSolution == 0 then there is no solution to the system *)
If[StringFreeQ[ToString[systemSolution],"{}"],noSolutionFlag=False,noSolutionFlag=True];

(* Check which rows have solutions and can be drawn as planes and with normal vectors *)
𝒫1Solution=Solve[𝒫1,{x,y,z}]; 𝒫1SolutionExist=StringFreeQ[ToString[𝒫1Solution],"{}"];
𝒫2Solution=Solve[𝒫2,{x,y,z}]; 𝒫2SolutionExist=StringFreeQ[ToString[𝒫2Solution],"{}"];
𝒫3Solution=Solve[𝒫3,{x,y,z}]; 𝒫3SolutionExist=StringFreeQ[ToString[𝒫3Solution],"{}"];

(* Display text etc. below the graphics window by using Labeled *)
Labeled[Show[
Graphics3D[{
If[showNormalVectors,
{If[𝒫1SolutionExist,arrow[{0,0,0},(Normalize[{a1,b1,c1}]*(range-5)),0.005,colorP1],Point[{0,0,0}]],
If[𝒫2SolutionExist,arrow[{0,0,0},(Normalize[{a2,b2,c2}]*(range-5)),0.005,colorP2],Point[{0,0,0}]],
If[𝒫3SolutionExist,arrow[{0,0,0},(Normalize[{a3,b3,c3}]*(range-5)),0.005,colorP3],Point[{0,0,0}]]
},Point[{0,0,0}] 
],

(* if a point solution exists show it as a red sphere *)
If[pointSolutionFlag,{Red,Sphere[{solX,solY,solZ},(range/30)]},Point[{0,0,0}]],Point[{0,0,0}],

(* Insert the x,y,z axes  *)
Line[{{0,0,-range},{0,0,range}}],Text[z,{0,0,range+1}],Line[{{-range,0,0},{range,0,0}}],Text[x,{range+1,0,0}],Line[{{0,-range,0},{0,range,0}}],Text[y,{0,range+1,0}]}
], (* end Graphics3D *)

If[lineSolutionFlag,
 (* Find out which variables are given to plot the line solution, it can be a combination of x,y or z *)
plotLineSolution[Union[StringCases[ToString[{solX,solY,solZ}],ch:CharacterRange["x","z"]]]/.{"x"->x,"y"->y,"z"->z},solX,solY,solZ],
showNothing ],

If[𝒫1SolutionExist,planeEqTo3D[𝒫1Solution,colorP1],showNothing],
If[𝒫2SolutionExist,planeEqTo3D[𝒫2Solution,colorP2],showNothing],
If[𝒫3SolutionExist,planeEqTo3D[𝒫3Solution,colorP3],showNothing],

If[planeSolutionFlag,
(* since all planes lie in the same plane show one of the planes in red as the solution *)
planeEqTo3D[Solve[𝒫1,{x,y,z}],Red],
showNothing],

FaceGrids->{{-1,0,0},{0,-1,0},{0,0,-1}},
Axes->True,
AxesLabel->{x,y,z},
PlotRange->{{-xRange,xRange},{-yRange,yRange},{-zRange,zRange}},
Background->RGBColor[0.922,0.918,0.941],
ImageSize->{400,350},
Lighting->"Neutral",
ViewPoint->{4.6,6.45,3.55},ImagePadding->25
], (* end Show *)

(* the following lines correspond with the Labeled keyword above and thereby inserts the text below the graphics window *)
Pane[
Row[{
Pane[
If[showAugmentedMatrix,
Column[{
(* show linear system as augmented matrix *)
(* RowBox is used here rather than Row to make the enclosing parentheses span all three rows of the augmented matrix *)
RowBox[{"(",Grid[{Style[#,12,colorP1]&/@{TraditionalForm[a1],TraditionalForm[b1],ToString[TraditionalForm[c1]]<>" "," "<>ToString[TraditionalForm[d1]]},Style[#,12,colorP2]&/@{TraditionalForm[a2],TraditionalForm[b2],ToString[TraditionalForm[c2]]<>" "," "<>ToString[TraditionalForm[d2]]},Style[#,12,colorP3]&/@{TraditionalForm[a3],TraditionalForm[b3],ToString[TraditionalForm[c3]]<>" "," "<>ToString[TraditionalForm[d3]]}},Dividers->{{False,False,False,True},{}},FrameStyle->Thickness[1],Alignment->Center,Spacings->{1,1}
],")"}]//DisplayForm (* end RowBox *)
}],(* end Column *)
Column[{
Text@Style["     "~~ToString[TraditionalForm[a1 x+b1 y+c1 z]]~~" = "~~ToString[TraditionalForm[d1]]~~"",12,colorP1],
Text@TraditionalForm[Text@Style["     "~~ToString[TraditionalForm[a2 x+b2 y+c2 z]]~~" = "~~ToString[TraditionalForm[d2]]~~"",12,colorP2]],
Text@TraditionalForm[Style["     "~~ToString[TraditionalForm[a3 x+b3 y+c3 z]]~~" = "~~ToString[TraditionalForm[d3]]~~"",12,colorP3]]
}] (* end Column *)
], (* end If *)
ImageSize->{200,90}
],(* end Pane *)
Pane[
If[noSolutionFlag,
Text@Style["No solution (inconsistent)",12],
Text@Style[TraditionalForm["   Solution: \n"~~StringReplace[ToString[TraditionalForm[systemSolution]],"->"..->"="]],12]
], (* end If *)
ImageSize->{160,90}
] (* end Pane *)
}], (* end Row *)
ImageSize->{400,90}
] (* end Pane *) 
 ] (* end Labeled *)
] (* end Quiet *)
],(* end Module *)

(* user-interface *)

Row[{
TabView[{
Style[Tooltip["row 1","set parameters for row 1"],Background->colorP1]->
Column[{
Row[{"a1"," ",Slider[Dynamic[a1],{Dynamic[a1Min],Dynamic[a1Max],1},Background->colorP1,ImageSize->Small]," ",Dynamic[a1]}],
Row[{"b1"," ",Slider[Dynamic[b1],{Dynamic[b1Min],Dynamic[b1Max],1},Background->colorP1,ImageSize->Small]," ",Dynamic[b1]}],
Row[{"c1"," ",Slider[Dynamic[c1],{Dynamic[c1Min],Dynamic[c1Max],1},Background->colorP1,ImageSize->Small]," ",Dynamic[c1]}],
Row[{"d1"," ",Slider[Dynamic[d1],{Dynamic[d1Min],Dynamic[d1Max],1},Background->colorP1,ImageSize->Small]," ",Dynamic[d1]}]
}],(* end Column *)
Style[Tooltip["row 2","set parameters for row 2"],Background->colorP2]->
Column[{
Row[{"a2"," ",Slider[Dynamic[a2],{Dynamic[a2Min],Dynamic[a2Max],1},Background->colorP2,ImageSize->Small]," ",Dynamic[a2]}],
Row[{"b2"," ",Slider[Dynamic[b2],{Dynamic[b2Min],Dynamic[b2Max],1},Background->colorP2,ImageSize->Small]," ",Dynamic[b2]}],
Row[{"c2"," ",Slider[Dynamic[c2],{Dynamic[c2Min],Dynamic[c2Max],1},Background->colorP2,ImageSize->Small]," ",Dynamic[c2]}],
Row[{"d2"," ",Slider[Dynamic[d2],{Dynamic[d2Min],Dynamic[d2Max],1},Background->colorP2,ImageSize->Small]," ",Dynamic[d2]}]
}],(* end Column *)
Style[Tooltip["row 3","set parameters for row 3"],Background->colorP3]->
Column[{
Row[{"a3"," ",Slider[Dynamic[a3],{Dynamic[a3Min],Dynamic[a3Max],1},Background->colorP3,ImageSize->Small]," ",Dynamic[a3]}],
Row[{"b3"," ",Slider[Dynamic[b3],{Dynamic[b3Min],Dynamic[b3Max],1},Background->colorP3,ImageSize->Small]," ",Dynamic[b3]}],
Row[{"c3"," ",Slider[Dynamic[c3],{Dynamic[c3Min],Dynamic[c3Max],1},Background->colorP3,ImageSize->Small]," ",Dynamic[c3]}],
Row[{"d3"," ",Slider[Dynamic[d3],{Dynamic[d3Min],Dynamic[d3Max],1},Background->colorP3,ImageSize->Small]," ",Dynamic[d3]}]
}](* end Column *)
}] (* end TabView *)
}], (* end Row *)

{{example,1,Style[Tooltip["examples","show different types of systems. Note: Disables row reduce checkbox"]]},1,5,1,ImageSize->Tiny,Enabled->(!showRowReduced)},

Row[{
Column[{
Row[{Tooltip["augmented matrix  ","tick to show augmented matrix"],Checkbox[Dynamic[showAugmentedMatrix]]}],
Row[{Tooltip["normal vectors  ","tick to show normal vectors"],Checkbox[Dynamic[showNormalVectors]]}],
Row[{Tooltip["row reduce  ","tick to show reduced row echelon form. Note: disables examples slider"],Checkbox[Dynamic[showRowReduced],Enabled->(example==1)]}]
}] (* end Column *)
}],(* end Row *)

{{range,30,Style[Tooltip["range","adjust range of enclosing box"]]},5,100,1,ImageSize->Tiny},
Delimiter,
Style[Tooltip["elementary row operations","perform the row operations from Gaussian elimination"],Bold],

Row[{
TabView[{
"multiply\nrow"->
Row[{
Column[{
Button["click to multiply",
{If[tickEqNum==1,
{
{a1,b1,c1,d1}=timesNum*{a1,b1,c1,d1};
adjustSliderMinMax[a1,Unevaluated[a1Min],Unevaluated[a1Max]];
adjustSliderMinMax[b1,Unevaluated[b1Min],Unevaluated[b1Max]];
adjustSliderMinMax[c1,Unevaluated[c1Min],Unevaluated[c1Max]];
adjustSliderMinMax[d1,Unevaluated[d1Min],Unevaluated[d1Max]];
},
Null]; (* end If *)
If[tickEqNum==2,
{
{a2,b2,c2,d2}=timesNum*{a2,b2,c2,d2};
adjustSliderMinMax[a2,Unevaluated[a2Min],Unevaluated[a2Max]];
adjustSliderMinMax[b2,Unevaluated[b2Min],Unevaluated[b2Max]];
adjustSliderMinMax[c2,Unevaluated[c2Min],Unevaluated[c2Max]];
adjustSliderMinMax[d2,Unevaluated[d2Min],Unevaluated[d2Max]];
},
Null]; (* end If *)
If[tickEqNum==3,
{
{a3,b3,c3,d3}=timesNum*{a3,b3,c3,d3};
adjustSliderMinMax[a3,Unevaluated[a3Min],Unevaluated[a3Max]];
adjustSliderMinMax[b3,Unevaluated[b3Min],Unevaluated[b3Max]];
adjustSliderMinMax[c3,Unevaluated[c3Min],Unevaluated[c3Max]];
adjustSliderMinMax[d3,Unevaluated[d3Min],Unevaluated[d3Max]];
},
Null]} (* end If *)
],(* end Button *)
Row[{"factor ",PopupMenu[Dynamic[timesNum],{2,3,4,5,6,7,8,9,10,1/10,1/9,1/8,1/7,1/6,1/5,1/4,1/3,1/2,-2,-3,-4,-5,-6,-7,-8,-9,-10,-1/10,-1/9,-1/8,-1/7,-1/6,-1/5,-1/4,-1/3,-1/2},FieldSize->{2.6,2}]
}],
Row[{"row ",RadioButtonBar[Dynamic[tickEqNum],Range[3]]}]
}] (* end Column *)
}] ,(* end Row *)

"swap"->
Row[{
Column[{
Button[Style["click to swap rows",Medium],
{tempList={Hold[{a1,b1,c1,d1}],Hold[{a2,b2,c2,d2}],Hold[{a3,b3,c3,d3}]};
{tempList[[swapEqNum1]],tempList[[swapEqNum2]]}={tempList[[swapEqNum2]],tempList[[swapEqNum1]]};newTempList=ReleaseHold[tempList];
{a1,b1,c1,d1}=newTempList[[1]] ;{a2,b2,c2,d2}=newTempList[[2]];{a3,b3,c3,d3}=newTempList[[3]];
If[(swapEqNum1==1||swapEqNum2==1),
{
adjustSliderMinMax[a1,Unevaluated[a1Min],Unevaluated[a1Max]];
adjustSliderMinMax[b1,Unevaluated[b1Min],Unevaluated[b1Max]];
adjustSliderMinMax[c1,Unevaluated[c1Min],Unevaluated[c1Max]];
adjustSliderMinMax[d1,Unevaluated[d1Min],Unevaluated[d1Max]];
},
Null]; (* end If *)
If[(swapEqNum1==2||swapEqNum2==2),
{
adjustSliderMinMax[a2,Unevaluated[a2Min],Unevaluated[a2Max]];
adjustSliderMinMax[b2,Unevaluated[b2Min],Unevaluated[b2Max]];
adjustSliderMinMax[c2,Unevaluated[c2Min],Unevaluated[c2Max]];
adjustSliderMinMax[d2,Unevaluated[d2Min],Unevaluated[d2Max]];
},
Null]; (* end If *)
If[(swapEqNum1==3||swapEqNum2==3),
{
adjustSliderMinMax[a3,Unevaluated[a3Min],Unevaluated[a3Max]];
adjustSliderMinMax[b3,Unevaluated[b3Min],Unevaluated[b3Max]];
adjustSliderMinMax[c3,Unevaluated[c3Min],Unevaluated[c3Max]];
adjustSliderMinMax[d3,Unevaluated[d3Min],Unevaluated[d3Max]];
},
Null]; (* end If *)
},ImageSize->Medium
],(* end Button "click to swap rows" *) 
Row[{"swap row ",RadioButtonBar[Dynamic[swapEqNum1],Range[3]]}],
Row[{"with row  ",RadioButtonBar[Dynamic[swapEqNum2],Range[3]]}]
}] (* end Column *)
}],(* end Row *)

"add multiple\nof row"->
Row[{
Column[{
Button[Style["click to add multiple of row",Medium],{tempParamList={{a1,b1,c1,d1},{a2,b2,c2,d2},{a3,b3,c3,d3}}; 
tempParamList[[onRowNum]]=Plus[tempParamList[[onRowNum]],(tempParamList[[fromRowNum]]*pmTimes)];
{{a1,b1,c1,d1},{a2,b2,c2,d2},{a3,b3,c3,d3}}=tempParamList;
Which[
onRowNum==1,
{
adjustSliderMinMax[a1,Unevaluated[a1Min],Unevaluated[a1Max]];
adjustSliderMinMax[b1,Unevaluated[b1Min],Unevaluated[b1Max]];
adjustSliderMinMax[c1,Unevaluated[c1Min],Unevaluated[c1Max]];
adjustSliderMinMax[d1,Unevaluated[d1Min],Unevaluated[d1Max]];
},
onRowNum==2,
{
adjustSliderMinMax[a2,Unevaluated[a2Min],Unevaluated[a2Max]];
adjustSliderMinMax[b2,Unevaluated[b2Min],Unevaluated[b2Max]];
adjustSliderMinMax[c2,Unevaluated[c2Min],Unevaluated[c2Max]];
adjustSliderMinMax[d2,Unevaluated[d2Min],Unevaluated[d2Max]];
},
onRowNum==3,
{
adjustSliderMinMax[a3,Unevaluated[a3Min],Unevaluated[a3Max]];
adjustSliderMinMax[b3,Unevaluated[b3Min],Unevaluated[b3Max]];
adjustSliderMinMax[c3,Unevaluated[c3Min],Unevaluated[c3Max]];
adjustSliderMinMax[d3,Unevaluated[d3Min],Unevaluated[d3Max]];
}
]
},ImageSize->Medium],(* end Button "click to add multiple of row" *)
Row[{"of row ",RadioButtonBar[Dynamic[fromRowNum],Range[3]]}],
Row[{"to row ",RadioButtonBar[Dynamic[onRowNum],Range[3]]}],
Row[{"factor ",PopupMenu[Dynamic[pmTimes],{1,2,3,4,5,6,7,8,9,10,1/10,1/9,1/8,1/7,1/6,1/5,1/4,1/3,1/2,-1,-2,-3,-4,-5,-6,-7,-8,-9,-10,-1/10,-1/9,-1/8,-1/7,-1/6,-1/5,-1/4,-1/3,-1/2},FieldSize->{2.6,2}]
}]
}](* end Column *)
}] (* end Row *)
}] (* end TabView *)
}], (* end Row *)

(* localize and initialize *)
{{a1,4},ControlType->None},{{b1,2},ControlType->None},{{c1,3},ControlType->None},{{d1,3},ControlType->None},
{{a2,1},ControlType->None},{{b2,2},ControlType->None},{{c2,3},ControlType->None},{{d2,3},ControlType->None},
{{a3,-1},ControlType->None},{{b3,-2},ControlType->None},{{c3,-1},ControlType->None},{{d3,3},ControlType->None},

{{a1Min,-20},ControlType->None},{{a1Max,20},ControlType->None},
{{b1Min,-20},ControlType->None},{{b1Max,20},ControlType->None},
{{c1Min,-20},ControlType->None},{{c1Max,20},ControlType->None},
{{d1Min,-20},ControlType->None},{{d1Max,20},ControlType->None},
{{a2Min,-20},ControlType->None},{{a2Max,20},ControlType->None},
{{b2Min,-20},ControlType->None},{{b2Max,20},ControlType->None},
{{c2Min,-20},ControlType->None},{{c2Max,20},ControlType->None},
{{d2Min,-20},ControlType->None},{{d2Max,20},ControlType->None},
{{a3Min,-20},ControlType->None},{{a3Max,20},ControlType->None},
{{b3Min,-20},ControlType->None},{{b3Max,20},ControlType->None},
{{c3Min,-20},ControlType->None},{{c3Max,20},ControlType->None},
{{d3Min,-20},ControlType->None},{{d3Max,20},ControlType->None},

{{a1m,4},ControlType->None},{{b1m,2},ControlType->None},{{c1m,3},ControlType->None},{{d1m,3},ControlType->None},
{{a2m,1},ControlType->None},{{b2m,2},ControlType->None},{{c2m,3},ControlType->None},{{d2m,3},ControlType->None},
{{a3m,-1},ControlType->None},{{b3m,-2},ControlType->None},{{c3m,-1},ControlType->None},{{d3m,3},ControlType->None},

{{a1mr,4},ControlType->None},{{b1mr,2},ControlType->None},{{c1mr,3},ControlType->None},{{d1mr,3},ControlType->None},
{{a2mr,1},ControlType->None},{{b2mr,2},ControlType->None},{{c2mr,3},ControlType->None},{{d2mr,3},ControlType->None},
{{a3mr,-1},ControlType->None},{{b3mr,-2},ControlType->None},{{c3mr,-1},ControlType->None},{{d3mr,3},ControlType->None},

{{𝒫1,{}},ControlType->None},{{𝒫2,{}},ControlType->None},{{𝒫3,{}},ControlType->None},{{eqs,{}},ControlType->None},

{{colorP1,RGBColor[0.388,0.6705,0.3607]},ControlType->None},
{{colorP2,RGBColor[0.329,0.259,0.78]},ControlType->None},
{{colorP3,RGBColor[0.788,0.573,0.247]},ControlType->None},
{{showAugmentedMatrix,True},ControlType->None},
{{showNormalVectors,False},ControlType->None},
{{showRowReduced,False},ControlType->None},
{{firstTimeNotOneFlag,True},ControlType->None},
{{firstTimeNotRowReduced,True},ControlType->None},
{{tickEqNum,1},ControlType->None},
{{timesNum,2},ControlType->None},
{{fromRowNum,1},ControlType->None},
{{onRowNum,2},ControlType->None},
{{pmTimes,1},ControlType->None},
{{swapEqNum1,1},ControlType->None},
{{swapEqNum2,2},ControlType->None},
{{tempList,{}},ControlType->None},
{{tempParamList,{}},ControlType->None},
{{newTempList,{}},ControlType->None},

ControlPlacement->Left,TrackedSymbols->Manipulate,AutorunSequencing->{{1,12}}
]

Journal: What is the maximum number of steps that it SHOULD take achieve row reduced echelon form? Explain.

Graph Theory

Graph theory is just one of the many applications of matrix algebra. In this example, the relation between the numbers is modulo 3. This means they are congruent (connected) under R if they have the same remainder when divided by 3. For example, 2 and 8 are connected because both 8 and 2 divided by 3 leaves a remainder of 2.

Notice that modulo is transitive. If two numbers are related to the same number then they are related to each other. If a≡b and b≡c, then a≡c.
See if you can figure out the other relations, then revert to the initial settings for the journal (+ sign at upper right).

Manipulate[
set=Table[i,{i,1,v}];
loopEdges=Table[{i,i},{i,1,v}];
allEdges=Flatten[Table[{i,j},{i,1,v},{j,1,v}],1];

points=Table[{Cos[2Pi j/v],Sin[2Pi j/v]},{j,1,v}];
verts=Table[Graphics[{PointSize[Large],Point[points[[j]]]}],{j,1,v}];

figs=Table[{{GrayLevel[0.9],Line[{points[[k1]],points[[k2]]}]},Arrow[{points[[k1]],points[[k2]]}],Arrow[{points[[k2]],points[[k1]]}],{Arrowheads[{-.04,.04}],Arrow[{points[[k1]],points[[k2]]}]}}, {k2,1,v} ,{k1,1,k2}     ];

loops=Table[With[{i=i},
Graphics[
Button[{Thick,Dynamic[GrayLevel[loopColors[[i]]   ]    ],Style[Text[i,1.1points[[i]]],Black],Circle[1.1points[[i]],0.1]},loopColors[[i]]=0.9-loopColors[[i]]  ]
]],{i,1,v}];

usedLoops=Pick[loopEdges,Take[loopColors,v],0.];

edges=Table[With[{j1=j1,j2=j2},Graphics[Button[{Thick,figs[[j1,j2,Mod[jis[[j1,j2]],4]+1]]},jis[[j1,j2]]=jis[[j1,j2]]+1] ]],{j1,1,v},{j2,1,j1}];

edgeTypeTable=Table[With[{j1=j1,j2=j2},Mod[jis[[j1,j2]],4]+1],{j1,1,v},{j2,1,j1}];

edgesTable=Table[{{},{j1,j2},{j2,j1},{{j1,j2},{j2,j1}}},{j1,1,v},{j2,1,j1}];

emp=Combinatorica`EmptyGraph[v,Combinatorica`Type->Combinatorica`Directed];

Switch[rel,1,

usedEdges=Sort[Union[usedLoops,Reverse/@Partition[Flatten[Table[edgesTable[[j1,j2,edgeTypeTable[[j1,j2]]    ]],  {j1,1,v},{j2,1,j1}]],2]]];
firstDisplay=Show[edges,loops,verts,ImageSize->{300,400}];usedGraph=Combinatorica`AddEdges[emp,usedEdges];
mtx=Style[MatrixForm[Combinatorica`ToAdjacencyMatrix[usedGraph]],24];textLine1="Your graph generates the relation";textLine2="Your graph has adjacency matrix";
textLine3="The relation generated by your graph is\n",

2,usedEdges=Pick[allEdges,divides/@allEdges,True];usedGraph=Combinatorica`AddEdges[emp,usedEdges];
mtx=Style[MatrixForm[Combinatorica`ToAdjacencyMatrix[usedGraph]],24];
textLine1=Column[{Row[{"The relation ",Style["aRb",Italic]," iff ",Style["a",Italic]," divides ",Style["b",Italic]}],Row[{"on ",set," is\n"}]}];
textLine2=Column[{Row[{"The graph of the relation\n",Style["aRb",Italic]," iff ",Style["a",Italic]," divides ",Style["b",Italic]}],Row[{"on ",set,"\nhas adjacency matrix"}]}];
textLine3=textLine1;
firstDisplay=Combinatorica`ShowGraph[usedGraph,Combinatorica`VertexLabel->True,ImageSize->{300,400}],

3,usedEdges=Pick[allEdges,congMod3/@allEdges];usedGraph=Combinatorica`AddEdges[emp,usedEdges];
mtx=Style[MatrixForm[Combinatorica`ToAdjacencyMatrix[usedGraph]],24];
textLine1=Column[{Row[{"The relation ",Style["aRb",Italic]," iff (",Style["a",Italic]," ≡ ",Style["b",Italic],") mod 3"}],Row[{"on ",set," is\n"}]}];
textLine2=Column[{Row[{"The graph of the relation\n",Style["aRb",Italic]," iff (",Style["a",Italic]," ≡ ",Style["b",Italic],") mod 3"}],Row[{"on ",set,"\nhas adjacency matrix"}]}];
textLine3=textLine1;
firstDisplay=Combinatorica`ShowGraph[usedGraph,Combinatorica`VertexLabel->True,ImageSize->{300,400}],

4,usedEdges=Pick[allEdges,aPlus2bPrime/@allEdges];usedGraph=Combinatorica`AddEdges[emp,usedEdges];
mtx=Style[MatrixForm[Combinatorica`ToAdjacencyMatrix[usedGraph]],24];
textLine1=Column[{Row[{"The relation ",Style["aRb",Italic]," iff ",Style["a",Italic]," + 2",Style["b",Italic]," is prime"}],Row[{"on ",set," is\n"}]}];
textLine2=Column[{Row[{"The graph of the relation\n",Style["aRb",Italic]," iff ",Style["a",Italic]," + 2",Style["b",Italic]," is prime"}],Row[{"on ",set,"\nhas adjacency matrix"}]}];
textLine3=textLine1;
firstDisplay=Combinatorica`ShowGraph[usedGraph,Combinatorica`VertexLabel->True,ImageSize->{300,400}]
];

(*the next three lines test for transitivity using the functions defined in the initialization area*)
tuples=tupler[usedEdges];
inThere=MemberQ[usedEdges,#]&;
If[MemberQ[inThere/@(pathShortener/@relevant[tuples]),False],trans=False,trans=True];

props={Combinatorica`ReflexiveQ[usedGraph],Combinatorica`SymmetricQ[usedGraph],Combinatorica`AntiSymmetricQ[usedGraph],trans};
propsList={"reflexive","symmetric","antisymmetric","transitive"};
usedProps=Pick[propsList,props,True];
propsDisplay=TableForm[usedProps];
If[usedProps=={"reflexive","symmetric","transitive"},message="The relation is an equivalence relation.",
If[usedProps=={"reflexive","antisymmetric","transitive"},message="The relation is a partial ordering.",
If[usedProps==propsList,message="The relation is both an equivalence relation and a partial ordering.",message=""]]];

Switch[show,1,secondDisplay=Style[Text@Column[{"",textLine1,Row[{Style["R",Italic]," = ",usedEdges}]}],18],
2,secondDisplay=Style[Text@Column[{"",textLine2,"",mtx  }],18],
3,secondDisplay=Style[Text@Column[{"",textLine3,propsDisplay,"",message}],18]

];

Pane[Grid[{{firstDisplay,secondDisplay}},Alignment->Top],ImageSize->600],

{{v,8,"number of vertices"},2,8,1,ControlType->Setter},
{{jis,Table[0,{j1,1,8},{j2,1,j1}]},ControlType->None},
{{loopColors,Table[0.9,{i,8}]},ControlType->None},
{{message,""},ControlType->None},
{{rel,3,"relation"},{1->"custom",2->"divides",3->"congruent mod 3",4->"a + 2b prime"},ControlType->RadioButtonBar},
{{show,2,"show"},{1->"ordered pairs",2->"adjacency matrix",3->"properties"},ControlType->RadioButtonBar},
Button["clear edges",jis=Table[0,{j1,1,8},{j2,1,j1}];loopColors=Table[0.9,{i,8}],ImageSize->100,Enabled->rel==1],
SynchronousInitialization->False,
Initialization:>(
Get["Combinatorica`"];
divides=Mod[#[[2]],#[[1]]]==0&;
congMod3=Mod[#[[2]]-#[[1]],3]==0&;
aPlus2bPrime=PrimeQ[#[[1]]+2#[[2]] ]&;

(*the functions below are used in testing for transitivity*)
tupler=Tuples[#,2]&;
tester=#[[1,2]]==#[[2,1]]&;
relevant=Pick[#,tester/@#,True]&;
pathShortener=Drop[Drop[Flatten[#],{-2}],{2}]&;

),
TrackedSymbols->True,
AutorunSequencing->{1,5,6}
]

Journal: Modulo 3 has 3 partitions or subgroups: 0,1, or 2. Which numbers above belong to 0? 1? 2? How many subgroups would modulo 10 have? Name them.

Challenge

Journal: Create a network connecting the 14 numbers in set A = [9,11,14,22,25,39,36,41,42,5,7,56,1005,23456] with the relation being modulo 4.